home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 14 / CU Amiga Magazine's Super CD-ROM 14 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-09].iso / CUCD / Programming / XPK / Source / Modula2 / xpk.mod
Encoding:
Text File  |  1997-02-15  |  3.1 KB  |  118 lines
  1. (*************************************************************************
  2.  
  3. :Program.    Xpk.mod
  4. :Contents.   General XPK file-to-file packer/unpacker
  5. :Author.     Oliver Knorr
  6. :Remark.     Derived from Hartmut Goebel's Oberon xpk
  7. :Language.   Modula-2
  8. :Translator. M2Amiga V4.0
  9. :History.    V1.0, 20 Jul 1992 Oliver Knorr
  10. :History.    V1.1, 30 Jul 1992 Oliver Knorr
  11. :Date.       30 Jul 1992 02:09:34
  12.  
  13. *************************************************************************)
  14.  
  15. MODULE Xpk;
  16.  
  17. FROM Arts       IMPORT Exit ;
  18. FROM DosD       IMPORT RDArgsPtr, ctrlC ;
  19. FROM DosL       IMPORT PrintFault, IoErr, ReadArgs, FreeArgs ;
  20. FROM ExecL      IMPORT SetSignal ;
  21. FROM SYSTEM     IMPORT CAST, TAG, VAL, ADR, ADDRESS, LONGSET ;
  22. FROM Terminal   IMPORT WriteString, WriteLn, FormatS, FormatNr ;
  23. FROM UtilityD   IMPORT tagEnd, Hook, HookPtr ;
  24. FROM XpkMasterD IMPORT StrPtr, errMsgSize, XpkTags, xpkFindMethod,
  25.                        XpkProgressPtr, XpkProgressType ;
  26. FROM XpkMasterL IMPORT XpkUnpack, XpkPack ;
  27.  
  28. IMPORT R ;
  29.  
  30. VAR
  31.   tags: ARRAY [0..12] OF LONGINT;
  32.   Res : LONGINT;
  33.   argc: INTEGER;
  34.   ErrBuf: ARRAY [0..errMsgSize] OF CHAR;
  35.   ChunkHook: Hook;
  36.  
  37. CONST
  38.  
  39.   Template = "infile/A,outfile/A,Mode";
  40.  
  41.   mode = 2;
  42.   infile = 0;
  43.   outfile = 1;
  44.  
  45. VAR
  46.   Argv: ARRAY [0..2] OF LONGINT;
  47.   Arguments: RDArgsPtr;
  48.  
  49. PROCEDURE End(text: ARRAY OF CHAR);
  50. BEGIN
  51.   WriteString(text);
  52.   WriteLn;
  53.   Exit(10);
  54. END End;
  55.  
  56. PROCEDURE ChunkFunc (myHook{R.A0}: HookPtr;
  57.                      object{R.A2}: ADDRESS;
  58.                      message{R.A1}: ADDRESS): ADDRESS;
  59.  
  60. VAR
  61.   prog: XpkProgressPtr;
  62.   st: StrPtr ;
  63.  
  64. BEGIN
  65.  
  66.   prog := message;
  67.   st := prog^.packerName ;
  68.   FormatS ("\r%4s: ", st^) ;
  69.   st := prog^.activity ;
  70.   FormatS ("%-9s ", st^) ;
  71.   st := prog^.fileName ;
  72.   FormatS ("%-12s ", st^) ;
  73.   WITH prog^ DO
  74.     FormatNr ("(%3ld%% done of ", done) ;
  75.     FormatNr ("%6ld bytes, ", uLen) ;
  76.     FormatNr ("%2ld%% CF, ", cf) ;
  77.     FormatNr ("%6ld cps) ", speed) ;
  78.     IF (type = ORD(progEnd)) THEN WriteLn; END;
  79.   END ;
  80.  
  81. RETURN CAST(ADDRESS, SetSignal(LONGSET{}, LONGSET{ctrlC}) * LONGSET{ctrlC});
  82.  
  83. END ChunkFunc;
  84.  
  85. BEGIN
  86.  
  87.   ChunkHook.entry := ChunkFunc;
  88.  
  89.   Arguments := ReadArgs(ADR(Template),ADR(Argv),NIL);
  90.   IF Arguments = NIL THEN
  91.     IF PrintFault(IoErr(),ADR("***Error")) THEN END;
  92.     Exit(20);
  93.   END;
  94.  
  95.   IF Argv[mode] = NIL THEN                   (* First try to decompress... *)
  96.     Res := XpkUnpack(TAG(tags,
  97.                          xpkInName,    Argv[infile],
  98.                          xpkOutName,   Argv[outfile],
  99.                          xpkGetError,  ADR(ErrBuf),
  100.                          xpkChunkHook, ADR(ChunkHook),
  101.                          xpkNoClobber, TRUE,
  102.                          tagEnd)) ;
  103.   ELSE
  104.     Res := XpkPack(TAG(tags,
  105.                        xpkInName,     Argv[infile],
  106.                        xpkOutName,    Argv[outfile],
  107.                        xpkGetError,   ADR(ErrBuf),
  108.                        xpkChunkHook,  ADR(ChunkHook),
  109.                        xpkFindMethod, Argv[mode],
  110.                        xpkNoClobber,  TRUE,
  111.                        tagEnd)) ;
  112.   END;
  113.   IF Res # 0 THEN End(ErrBuf); END;
  114.  
  115. CLOSE
  116.   IF Arguments # NIL THEN FreeArgs(Arguments); END;
  117. END Xpk.
  118.